home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 076-100 / scopedisk78 / sd / path.mod < prev    next >
Encoding:
Modula Implementation  |  1995-03-19  |  1.2 KB  |  67 lines
  1. IMPLEMENTATION MODULE Path;
  2.  
  3. FROM AmigaDOS    IMPORT    ParentDir, FileLock, Lock, UnLock, AccessRead, 
  4.             IoErr, Examine, FileInfoBlockPtr;
  5. FROM Memory    IMPORT    AllocMem, FreeMem, MemReqSet, MemPublic, MemClear;
  6. FROM Strings    IMPORT    ConcatString;
  7.  
  8.  
  9. PROCEDURE PathName(lock : FileLock; VAR dest : ARRAY OF CHAR): BOOLEAN;
  10. VAR
  11.     fib : FileInfoBlockPtr;
  12.     status : BOOLEAN;
  13.  
  14.     PROCEDURE path(lock : FileLock; printslash : BOOLEAN);
  15.     VAR
  16.         newlock : FileLock;
  17.         error : LONGINT;
  18.     BEGIN
  19.         IF lock = 0D THEN 
  20.             RETURN;
  21.          END;
  22.  
  23.         newlock := ParentDir(lock);
  24.         error := IoErr();
  25.  
  26.         IF (newlock = 0D) AND (error <> 0D) THEN
  27.             UnLock(newlock);
  28.             RETURN;
  29.         END;
  30.  
  31.         path(newlock,TRUE);
  32.  
  33.         IF Examine(lock,fib^) THEN
  34.             ConcatString(dest, fib^.fibFileName);
  35.             IF newlock = 0D THEN
  36.                 ConcatString(dest,':');
  37.             ELSIF printslash THEN
  38.                 ConcatString(dest,'/');
  39.             END;
  40.         ELSE
  41.             UnLock(newlock);
  42.             status := FALSE;
  43.             RETURN;
  44.         END;
  45.  
  46.         UnLock(newlock);
  47.     END path;
  48.  
  49. BEGIN
  50.     status := TRUE;
  51.  
  52.     fib := AllocMem(SIZE(fib^),MemReqSet{MemPublic,MemClear});
  53.     IF fib = NIL THEN
  54.         RETURN(FALSE);
  55.     END;
  56.  
  57.     path(lock,FALSE);
  58.  
  59.     IF fib <> NIL THEN
  60.         FreeMem(fib,SIZE(fib^));
  61.     END;
  62.  
  63.     RETURN(status);
  64. END PathName;
  65.  
  66. END Path.
  67.